home *** CD-ROM | disk | FTP | other *** search
/ CD Actual 3 / CD ACTUAL 3.iso / linux / incoming / jstools-.6v3 / jstools- / jstools-tk3.6v3.0 / lib / jrichtext.tcl < prev    next >
Encoding:
Text File  |  1995-02-05  |  8.4 KB  |  246 lines
  1. # jrichtext.tcl - procedures for dealing with rich text
  2. # 
  3. # Copyright 1992-1994 by Jay Sekora.  All rights reserved, except 
  4. # that this file may be freely redistributed in whole or in part 
  5. # for non¡profit, noncommercial use.
  6. ######################################################################
  7.  
  8. # CHANGES:
  9. #   dual usage; j:rt:textfonts with a text widget vs. full rich-text
  10.  
  11. # j:tagged_insert w text args - insert tagged text into a text widget
  12. # j:rt text dest - prepare to write rich text to text widget dest
  13. # j:rt:type - return type of current rich text destination (text, TeX)
  14. # j:rt:destination - return current rich text destination (widget, file)
  15. # j:rt:textfonts {style font}... - set fonts for text widget
  16. # j:rt:done - finish writing rich text (clear vars, close files)
  17. # j:rt:rm text - write rich text (roman)
  18. # j:rt:it text - write rich text (italic)
  19. # j:rt:bf text - write rich text (bold face)
  20. # j:rt:bi text - write rich text (bisexual)
  21. # j:rt:tt text - write rich text (typewriter - monospaced)
  22. # j:rt:hl text - write rich text (`headline' - larger bold)
  23. # j:rt:tab - tab in rich text
  24. # j:rt:cr - line break in rich text
  25. # j:rt:par - paragraph break in rich text
  26. # j:rt:mkabbrevs - make shorter convenience procs, for text-intensive apps
  27. # rm - dummy do-nothing procedure to prevent unknown from calling /bin/rm
  28. #   if you forget to j:rt:mkabbrevs
  29.  
  30. ######################################################################
  31. # j:tagged_insert - append to a text widget with a particular tag
  32. #   (lifted from mkStyles.tcl demo, where it was insertWithTags)
  33. ######################################################################
  34.  
  35. # The procedure below inserts text into a given text widget and
  36. # applies one or more tags to that text.  The arguments are:
  37. #
  38. # w        Window in which to insert
  39. # text        Text to insert (it's inserted at the "insert" mark)
  40. # args        One or more tags to apply to text.  If this is empty
  41. #        then all tags are removed from the text.
  42.  
  43. proc j:tagged_insert {w text args} {
  44.   set start [$w index insert]
  45.   $w insert insert $text
  46.   foreach tag [$w tag names $start] {
  47.     $w tag remove $tag $start insert
  48.   }
  49.   foreach i $args {
  50.     $w tag add $i $start insert
  51.   }
  52. }
  53.  
  54. ######################################################################
  55. # j:rt text dest - prepare to write rich text to text widget dest
  56. #   future versions will support PostScript, TeX, maybe canvas, etc.
  57. ######################################################################
  58.  
  59. proc j:rt { {type {}} {destination stdout} } {
  60.   global j_rt
  61.   
  62.   case $type in {
  63.     {text} {            ;# output to a text widget
  64.       set j_rt(type) $type
  65.       set j_rt(destination) $destination
  66.       $j_rt(destination) delete 0.0 end
  67.       $j_rt(destination) configure -wrap word
  68.       catch {
  69.         $j_rt(destination) configure -font \
  70.           -adobe-helvetica-medium-r-normal--*-120-*
  71.         $j_rt(destination) tag configure richtext:font:roman -font \
  72.           -adobe-helvetica-medium-r-normal--*-120-*
  73.         $j_rt(destination) tag configure richtext:font:italic -font \
  74.           -adobe-helvetica-medium-o-normal--*-120-*
  75.         $j_rt(destination) tag configure richtext:font:bold -font \
  76.           -adobe-helvetica-bold-r-normal--*-120-*
  77.         $j_rt(destination) tag configure richtext:font:bolditalic -font \
  78.           -adobe-helvetica-bold-o-normal--*-120-*
  79.         $j_rt(destination) tag configure richtext:font:typewriter -font \
  80.           -adobe-courier-medium-r-normal--*-120-*
  81.         $j_rt(destination) tag configure richtext:font:heading0 -font \
  82.           -adobe-helvetica-bold-o-normal--*-240-*
  83.         $j_rt(destination) tag configure richtext:font:heading1 -font \
  84.           -adobe-helvetica-bold-o-normal--*-180-*
  85.         $j_rt(destination) tag configure richtext:font:heading2 -font \
  86.           -adobe-helvetica-bold-o-normal--*-140-*
  87.         $j_rt(destination) tag configure richtext:font:heading3 -font \
  88.           -adobe-helvetica-bold-o-normal--*-120-*
  89.         $j_rt(destination) tag configure richtext:font:heading4 -font \
  90.           -adobe-helvetica-bold-o-normal--*-100-*
  91.         $j_rt(destination) tag configure richtext:font:heading5 -font \
  92.           -adobe-helvetica-bold-o-normal--*-80-*
  93.       }
  94.     }
  95.     default {
  96.       tkerror "j:rt $type $destination: only type \"text\" is supported."
  97.     }
  98.   }
  99. }
  100.  
  101. ######################################################################
  102. # j:rt:textfonts w {{style fontlist}...} - set fonts for text widget w
  103. #   style is one of {roman italic bold bolditalic typewriter} or
  104. #   {heading0, ..., heading5}; font is list of X fonts, in order of
  105. #   decreasing preference (cf j:configure_tag_font in jtkutils.tcl).
  106. ######################################################################
  107.  
  108. proc j:rt:textfonts { w list } {
  109.   foreach pair $list {
  110.     set tag "richtext:font:[lindex $pair 0]"
  111.     set fontlist [lindex $pair 1]
  112.     j:configure_tag_font $w $tag $fontlist
  113.   }
  114. }
  115.  
  116. ######################################################################
  117. # j:rt:type - return type of current rich text destination (text, TeX)
  118. ######################################################################
  119.  
  120. proc j:rt:type {} {
  121.   global j_rt
  122.   
  123.   if { (! [info exists j_rt(type)])} {
  124.     # this might be considered an error
  125.     return {}
  126.   } else {
  127.     return $j_rt(type)
  128.   }
  129. }
  130.  
  131. ######################################################################
  132. # j:rt:destination - return current rich text destination (widget, file)
  133. ######################################################################
  134.  
  135. proc j:rt:destination {} {
  136.   global j_rt
  137.   
  138.   if { (! [info exists j_rt(destination)]) } {
  139.     # this might be considered an error
  140.     return {}
  141.   } else {
  142.     return $j_rt(destination)
  143.   }
  144. }
  145.  
  146. ######################################################################
  147. # j:rt:done - finish writing rich text (clear vars, close files)
  148. ######################################################################
  149.  
  150. proc j:rt:done {} {
  151.   global j_rt
  152.  
  153.   # to start, would close files if appropriate
  154.   
  155.   set j_rt(type) {}
  156.   set j_rt(destination) {}
  157. }
  158.   
  159. ######################################################################
  160. # CREATE PROCEDURES FOR:
  161. # j:rt:rm text - write rich text (roman)
  162. # j:rt:it text - write rich text (italic)
  163. # j:rt:bf text - write rich text (bold face)
  164. # j:rt:bi text - write rich text (bisexual)
  165. # j:rt:tt text - write rich text (typewriter - monospaced)
  166. # j:rt:hl text - write rich text (`headline' - larger bold)
  167. ######################################################################
  168.  
  169. set tmp_body {
  170.   set type [j:rt:type]
  171.   
  172.   case $type in {
  173.     {text} {            ;# output to a text widget
  174.       j:tagged_insert [j:rt:destination] $text $tag
  175.     }
  176.     default {
  177.       tkerror "j:rt type \"$type\" is not supported."
  178.     }
  179.   }
  180. }
  181.  
  182. foreach pair {
  183.   {rm roman}
  184.   {it italic}
  185.   {bf bold}
  186.   {bi bolditalic}
  187.   {tt typewriter}
  188.   {hl heading1}
  189.   {h0 heading0}
  190.   {h1 heading1}
  191.   {h2 heading2}
  192.   {h3 heading3}
  193.   {h4 heading4}
  194.   {h5 heading5}
  195. } {
  196.   set command [lindex $pair 0]
  197.   set style [lindex $pair 1]
  198.   proc j:rt:$command {text} "  set tag richtext:font:$style\n$tmp_body"
  199. }
  200.  
  201. ######################################################################
  202. # j:rt:tab - tab in rich text
  203. ######################################################################
  204.  
  205. proc j:rt:tab {} {
  206.   j:rt:rm "\t"
  207. }
  208.  
  209. ######################################################################
  210. # j:rt:cr - line break in rich text
  211. ######################################################################
  212.  
  213. proc j:rt:cr {} {
  214.   j:rt:rm "\n"
  215. }
  216.  
  217. ######################################################################
  218. # j:rt:par - paragraph break in rich text
  219. ######################################################################
  220.  
  221. proc j:rt:par {} {
  222.   j:rt:rm "\n\n"
  223. }
  224.  
  225. ######################################################################
  226. # j:rt:mkabbrevs - make shorter convenience procs, for text-intensive apps
  227. ######################################################################
  228.  
  229. # this creates shorter aliases rm, it, bf, bi, tt, hl, tab, cr, and
  230. # par identical to the corresponding procedures starting with "j:rt:"
  231.  
  232. proc j:rt:mkabbrevs {} {
  233.   foreach proc {rm it bf bi tt hl tab cr par} {
  234.     proc $proc [info args j:rt:$proc] [info body j:rt:$proc]
  235.   }
  236. }
  237.  
  238. ######################################################################
  239. # rm - dummy do-nothing procedure to prevent unknown from calling /bin/rm
  240. #   if you forget to j:rt:mkabbrevs
  241. ######################################################################
  242.  
  243. proc rm {args} {
  244.   tkerror "Called `rm' without calling `j:rt:mkabbrevs'."
  245. }
  246.